perm filename P[X,ALS] blob sn#075318 filedate 1973-12-02 generic text, type T, neo UTF8
00010	BEGIN "FIX"
00020	DEFINE ⊂="COMMENT"; ⊂ NOV.26,1973;
00025	⊂ The initial program to prepare files of input parameters obtained
00027	  pulse synchronously from the acoustic files and to convert header
00028	  information into this same form;
00040	DEFINE ⊃="⊂";
00050	DEFINE CR="'15",LF="'12",CRLF="CR&LF",TB="'11";
00060	REQUIRE "DPYSUB.HDR[1,PDQ]" SOURCE_FILE;
00070	LABEL STARTP,STOPP,TOFORM;
00080	 DEFINE \=" "; ⊂ DEFINE \="SAFE"; ⊂ Alternarte definitions;
00090	⊂ REQUIRE "LPC2[X,ALS]" LOAD_MODULE;
00095	⊂ require "PREPAR[X,ALS]" LOAD_MODULE;
00100	FORTRAN REAL PROCEDURE SQRT(REAL X);
00110	FORTRAN REAL PROCEDURE ALOG10(REAL X);
00120	FORTRAN REAL PROCEDURE COS(REAL X);
00130	FORTRAN REAL PROCEDURE SIN(REAL X);
00140	INTEGER ZEROC,ZEROF,DX;
00150	⊂ EXTERNAL FORTRAN PROCEDURE LPC1(REFERENCE REAL A,B,R0,C;⊂ REFERENCE INTEGER N,I,J);
00160	REQUIRE "F[X,ALS]" LOAD_MODULE;
00170	EXTERNAL FORTRAN PROCEDURE FRXFM
00180	         (REFERENCE INTEGER M;REFERENCE REAL X,Y);
00185	⊂ EXTERNAL PROCEDURE PREPARE;
00190	\ INTERNAL REAL ARRAY A,B,C,D[0:512];
00200	REAL X,SX; \ REAL ARRAY WINDOW[0:512];
00210	INTERNAL REAL R0;
00220	INTEGER LPCOPT;
00230	\ INTEGER ARRAY DPYBUF[0:1535];
00240	\ INTEGER ARRAY LFILE[0:'177];
00250	\ INTEGER ARRAY SYMBOL[0:127];
00260	\ INTEGER ARRAY DAT,AVDAT[0:23];
00270	\ INTEGER ARRAY FVAL[0:8];
00275	\ INTEGER ARRAY NEW[0:512];
00276	\ INTEGER ARRAY PFFT[0:64]; INTEGER SIZE;
00277	INTEGER NX;
00280	INTEGER FX,SEGCS;
00290	STRING ARRAY SAMPLE[0:127];
00300	INTEGER I,J,K,L,P,PP,Q,QQ,R,DK,DDK,DDDK,DVAL,DDVAL,DDDVAL,
00310	        POINTX,STATE,DELTA,VAL,CHAN1,EOF,POINTT,POINTV;
00320	INTERNAL INTEGER M,N;
00330	INTEGER PT0,PT1,PT2,X0,X1,Y0,Y1,X2,Y2,
00340	        PTCNT,PICK,JP,JPX,OPT,OPT1,SHUFCT;
00350	INTEGER II,JJ,KK,NN,SEGC,BRK,EOFA,EOFT,EOFTF,READ3,LFX,
00360	        SEGTOT,SEGIN,IIT,JJT,KKT,NNT,ITT,JTT,KTT,SEGCT;
00370	BOOLEAN ER;
00380	INTEGER CHAN2,CHAN3,CHAN4,CHAN5,CHAN6,CHANX;
00390	\ INTEGER ARRAY BUF,BUFT,BUFTT[0:511];
00400	STRING FILEN,READ,READ1,READT,READTT,FILEO,READ2,FILEQ,TFILE,FILLST,FILEP;
00410	
00420	PROCEDURE OUTALL(STRING S);
00430	BEGIN
00440	STRING SS; INTEGER J;
00450	SETBREAK(18,0,NULL,"OSN");
00460	SS←SCAN(S,18,J);
00470	OUTSTR(SS);
00480	END;
00490	
00500	PROCEDURE DATAIN;
00510	BEGIN
00520	INTEGER J;
00530	  FOR J←0 STEP 1 UNTIL 511 DO BUF[J]←0;
00540	  IF EOF=0 THEN ARRYIN(CHAN1,BUF[0],512);
00570	  POINTX←POINT(12,BUF[0],-1);
00580	SEGC←II←II+12; JJ←II+11;
00590	END;
00600	
00610	PROCEDURE DATTIN;
00620	BEGIN
00630	INTEGER J;
00640	  FOR J←0 STEP 1 UNTIL 511 DO BUFT[J]←0;
00650	  IF EOFA=0 THEN ARRYIN(CHAN2,BUFT[0],512);
00680	  POINTT←POINT(6,BUFT[0],-1);
00690	SEGCT←IIT←IIT+128; JJT←IIT+127;
00700	END;
00710	
00720	PROCEDURE DTTTIN;
00730	BEGIN
00740	INTEGER J;
00750	  IF EOFT=0 THEN ARRYIN(CHAN3,BUFTT[0],512)
00760	  ELSE OUTSTR
00770	       ("No more .P data with JJ= "&CVS(JJ)&"SEGC= "&CVS(SEGC)&CRLF);
00780	  FOR J←0 STEP 1 UNTIL 511 DO IF BUFTT[J]=0 THEN BUFTT[J]←'377777777777;
00790	  ITT←BUFTT[0] LSH -15; KTT←0; JTT←BUFTT[511] LSH -15;
00800	⊂ FOR J←0 STEP 1 UNTIL 10 DO OUTSTR(CVOS(BUFTT[J])&TB);
00810	END;
00820	
02070	
02080	PROCEDURE RARDIS;
02090	BEGIN
02100	INTEGER I,J,K,SP;
02110	INTEGER LY,DY;
02120	REAL MAX,MIN;
02130	
02140	
02150	MAX←-1000.;MIN←10000.;
02160	FOR I←0 STEP 1 UNTIL 256 DO  IF C[I]>MAX THEN MAX←C[I];
02170	SP←6;  COMMENT HORIZONTAL SPACING;
02180	FOR I←0 STEP 1 UNTIL 256 DO BEGIN 
02190	  C[I]←5.5*(C[I]+48-MAX); IF C[I]<0 THEN C[I]←0; END;
02210	
02220	
02230	RIVECT(35,130);
02240	
02250	SETFORMAT(1,0);
02260	⊂ Write horizantal numbers;
02270	FOR I←0 STEP 1 UNTIL 5 DO BEGIN
02280	  DPYSST(CVS(I)); RIVECT(139,0); END; RIVECT(-139,0);
02290	FOR I←6 STEP 1 UNTIL 10 DO BEGIN
02300	  RIVECT(36,0); DPYSST(CVS(I)); END; RIVECT(-22,-5);
02310	 RIVECT(-512,0); RIVECT(-512,0);
02320	
02330	rivect(-1,0); ⊂ Start with 1 off so total will be correct;
02340	⊂ Draw scale to 5000, with 50 markers to 770;
02350	FOR I←1 STEP 1 UNTIL 5 DO BEGIN
02360	  FOR J←1 STEP 1 UNTIL 2 DO BEGIN
02370	    FOR K←1 STEP 1 UNTIL 2 DO BEGIN
02380	      RIVECT(15,0); RIVECT(0,-10); RVECT(0,10);
02390	      RIVECT(16,0); RIVECT(0,-10); RVECT(0,10); END;
02400	    RIVECT(15,0); RIVECT(0,-50); RVECT(0,50); END;
02410	  RIVECT(0,-264); RVECT(0,264); END;
02420	
02430	⊂ Draw scale from 5000 to 10,000, with 25 markers to 255;
02440	FOR I←1 STEP 1 UNTIL 5 DO BEGIN
02450	  FOR J←1 STEP 1 UNTIL 4 DO BEGIN
02460	    RIVECT(10,0); RIVECT(0,-10); RVECT(0,10); END;
02470	  RIVECT(11,0); RIVECT(0,-264); RVECT(0,264); END;
02480	RVECT(-512,0); RVECT(-512,0);
02490	
02500	SETFORMAT(2,0);
02510	⊂ Vertical numbers and vertical scale;
02520	FOR I←0 STEP 12 UNTIL 42 DO BEGIN
02530	  RIVECT(-35,-7); DPYSST(CVS(I)); RIVECT(15,7);
02540	  RVECT(-10,0); RIVECT(0,-33);
02550	  RIVECT(-35,-7); DPYSST(CVS(I+6)); RIVECT(10,7);
02560	  RVECT(-5,0);RIVECT(0,-33); END;
02570	RIVECT(0,264); RVECT(0,-264);
02580	RIVECT(-35,-7); DPYSST(CVS(I)); RIVECT(5,7);
02590	  RVECT(512,0); RVECT(512,0); RIVECT(-512,0); RIVECT(-512,0);
02600	
02610	LY←C[0]; RIVECT(0,LY);
02620	FOR I←1 STEP 1 UNTIL 128 DO
02630	BEGIN
02640		DY←C[I]-LY;
02650		LY←LY+DY;
02660		RVECT(SP,DY);
02670	END;
02680	SP←2;
02690	FOR I←129 STEP 1 UNTIL 256 DO
02700	BEGIN
02710		DY←C[I]-LY;
02720		LY←LY+DY;
02730		RVECT(SP,DY);
02740	END;
02750	RIVECT(0,108-LY);
02755	DPYOUT(0); PTOCHW(0,'10120);
02760	END "RARDIS";
02770	
03070	
03080	INTERNAL PROCEDURE FORM(INTEGER LPCOPT);
03090	BEGIN "FORM"
03100	REAL ERRN,ERR;
03110	INTEGER I,J;
03120	 M←9; N←2↑M; DEFINE PI="3.141592653";
03130	IF FX=0 THEN
03140	  FOR I←0 STEP 1 UNTIL N DO  WINDOW[I]←(1-COS((2*PI*I)/N))/2
03150	
03160	  ELSE BEGIN N←FVAL[FX+1]-FVAL[FX]; J←0;
03170	    FOR I←0 STEP 1 UNTIL FVAL[FX] DO WINDOW[I]←0;
03180	    FOR I←FVAL[FX] STEP 1 UNTIL FVAL[FX+1] DO BEGIN
03190	      WINDOW[I]←(1-COS((2*PI*J)/N))/2; J←J+1; END;
03200	    FOR I←FVAL[FX+1] STEP 1 UNTIL 512 DO WINDOW[I]←0; END;
03210	  FOR I←0 STEP 1 UNTIL 512 DO A[I]←D[I];
03220	
03230	IF LPCOPT=0 THEN BEGIN "LPC"
03240	  FOR I←0 STEP 1 UNTIL N-2 DO A[I]←(A[I+1]-A[I])*WINDOW[I];
03250	 ⊂  LOADS DATA IN A, DIFFERENTIATES AND WINDOWS ;
03260	I←24; J←N%2;
03270	⊂  LPC1(A[0],B[0],R0,C[0],N,I,J);
03280	END "LPC" ELSE
03290	
03300	BEGIN "FFT"
03310	FOR I←0 STEP 1 UNTIL 512 DO BEGIN
03320	  A[I]←D[I]*WINDOW[I]; B[I]←0;
03330	⊃ SETFORMAT(10,3); ⊃  OUTSTR(CVS(I)&TB&CVG(D[I])&TB&CVG(A[I])&CRLF);
03340	END;
03350	FRXFM(M,A[0],B[0]);
03360	⊃ OUTSTR("FFT COMPLETE"&CRLF);
03365	J←0;
03370	FOR I←0 STEP 1 UNTIL 256 DO BEGIN
03380	  X←A[I]↑2+B[I]↑2+1.*10↑-37;
03385	IF X>J THEN J←X;
03390	⊃ OUTSTR(CVG(A[I])&"  "&CVG(B[I])&"  "&CVG(X)&TB);
03400	  C[I]←10.*ALOG10(X); END;
03405	⊂ IF J%N>SIZE THEN BEGIN SIZE←J%N;
03407	⊂   OUTSTR("SIZE="&CVS(SIZE%256)&CRLF); ⊂ END;
03410	END "FFT";	
03420	
03440	END "FORM";
03450	
03460	PROCEDURE MARK;
03470	BEGIN "MARK"
03480	INTEGER I,JJ,K,L,JJP,LP,PT2;
03490	
03530	RIVECT(0,-130); SETFORMAT(3,0);
03540	FOR I←0 STEP 20 UNTIL 340 DO BEGIN
03550	  DPYSST(CVS(I)); RIVECT(15,0); END;
03560	RIVECT(-555,30); RIVECT(-500,0);
03570	
03580	FOR I←0 STEP 100 UNTIL 300 DO BEGIN "HUNDRED"
03590	  RIVECT(0,30); RVECT(0,-30);
03600	  FOR JJ←0 STEP 50 UNTIL 50 DO BEGIN "FIFTY"
03610	    FOR K←1 STEP 1 UNTIL 5 DO BEGIN "TEN"
03620	      RIVECT(15,0); RVECT(0,5); RIVECT(0,-5);
03630	      RIVECT(15,0); RVECT(0,10);RIVECT(0,-10);
03640	      END "TEN";
03650	    RVECT(0,20); RIVECT(0,-20);
03660	    IF I≥300 THEN DONE "HUNDRED";
03670	    END "FIFTY";
03680	  END "HUNDRED";
03690	RIVECT(-550,100); RIVECT(-500,0);
03700	
03710	K←D[0]%8; RIVECT(0,K);
03720	FOR I←1 STEP 1 UNTIL 350 DO BEGIN
03730	  JJP←D[I]%8;
03740	  LP←JJP-K; RVECT(3,LP); K←JJP; END;
03750	RIVECT(-550,-K); RIVECT(-500,0);
03760	
03820	    RIVECT(500,0);
03830	      FOR JJ←1 STEP 1 UNTIL 2 DO BEGIN
03840	        L←3*FVAL[JJ]-500;
03850	        RIVECT(L,100); RVECT(0,-100); RIVECT(-25,0); RVECT(50,0);
03860	        RIVECT(-25,0); RVECT(0,-100); RIVECT(-L,100); END;
03870	      RIVECT(-500,0);
03880	      DPYOUT(0); PTOCHW(0,'10120);
04020	
04030	END "MARK";
04040	
04050	INTERNAL PROCEDURE CALCOMP(STRING FILE;INTEGER ARRAY BUFR);
04060	⊃ Outputs display buffer BUFR to disk file FILE in a format
04070	readable by the Nealy Calcomp plotter program PLTVEC, and by
04080	the Quam Video Synthesizer program MIRTOP;
04090	IF FILE THEN
04100	BEGIN	INTEGER DSIZ,CCCHN;
04110		OPEN(CCCHN←GETCHAN,"DSK",'14,0,1,0,0,0);
04120		ENTER(CCCHN,FILEN&".GRF",0);
04130	OUTSTR("READY TO DPYPARS");
04140		DPYPARS;DSIZ←BUFR[1]+4;
04150	OUTSTR("BACK FROM DPYPARS"&CRLF);
04160		ARRYOUT(CCCHN,BUFR[0],2);WORDOUT(CCCHN,0);
04170		ARRYOUT(CCCHN,BUFR[2],DSIZ-2);
04180		RELEASE(CCCHN);
04190	END "CALCOMP";
     

00010	
00030	FILEN←"HI20.001[CMP,JH]";
00040	FILEO←"SEG1.FRI";
00050	⊂ HEADIN;
00060	STDBRK(1);
00070	 SETBREAK(14,"∃",NULL,"INS");
00080	 SETBREAK(15,'11&'12&'14&'15&'40,NULL,"INS");
00090	 SETBREAK(16,'56,NULL,"INA");
00100	 SETBREAK(17,'12,'15,"INS");
00110	
00120	CHAN1←1; CHAN2←2; CHAN3←3;  CHAN4←4; CHAN5←5; CHAN6←6;
00130	OUTSTR("This program generates files in the new format containing header"&
00135	  " information"&CRLF&
00137	  "  and pulse synchronous parameters for each pulse period, packed 4 to"&
00138	  " word."&CRLF&LF);
00139	
00150	OUTSTR("At present this program takes acoustic data from [CMP,JH],"&
00160	   CRLF&tb&"indentifying information from MAP.PHM[11,ALS]"&CRLF&
00170	   TB&"pulse informstion from .P[PIT,NJM] files"&CRLF&TB&
00180	   "and header information from files .T0X[11,ALS]."&CRLF&LF);
00185	outstr("It creates files .SYN[SYN,ALS]."&CRLF);
00300	
00310	CLOSE(CHAN4); OPEN(CHAN4,"DSK",1,2,0,3500,BRK,EOFA);
00320	LOOKUP(CHAN4,"MAP.PHN[11,ALS]",ER);
00330	WHILE ER DO BEGIN OUTSTR(CRLF&"Can't find MAP.PHN[11,ALS].  File = ");
00340	LOOKUP(CHAN4,TFILE←INCHWL,ER); END;  EOFA←0;
00350	FILLST←INPUT(CHAN4,14);
00360	CLOSE(CHAN4);
00370	
00380	FOR I←0 STEP 1 UNTIL 127 DO  BEGIN
00390	  WHILE TRUE DO BEGIN
00400	    READ1←SCAN(FILLST,17,K);
00410	    READ3←READ1[1 TO 1];
00420	    IF READ3≠"⊂"  THEN DONE; END;
00430	IF READ3="" THEN DONE;
00440	  SYMBOL[I]←CVASC(SCAN(READ1,15,K));
00450	  SAMPLE[I]←READ1; END;
00460	
00470	STARTP:
00580	DELTA←15;
00590	⊂ OUTSTR("Specify DELTA (CR for 15) ");
00600	⊂ IF (READ←INCHWL)="" THEN DELTA←15 ELSE DELTA←CVD(READ);
00610	
00620	OUTSTR(CRLF&"Type number of file to start (CR only for 1) ");
00630	IF (READ←INCHWL)="" THEN PP←1 ELSE PP←CVD(READ);
00640	TYPLOC(512,100);
00645	
00647	⊂ Begin FILEREAD;
00650	FOR PP←PP STEP 1 UNTIL 26 DO BEGIN "FILEREAD"
00660	  CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
00670	SETFORMAT(-3,0); FILEQ←CVS(PP);
00680	  FILEN←FILEN[1 TO 5]&FILEQ&"[CMP,JH]";
00690	LOOKUP(CHAN1,FILEN,ER); TFILE←FILEN;
00700	WHILE ER DO BEGIN
00710	   IF PP>1 THEN BEGIN OUTSTR("Out of data, will terminate."&CRLF);
00720	     GOTO STOPP; END;
00730	   OUTSTR(CRLF&"Can not find file "&TFILE&"  File= ");
00740	   LOOKUP(CHAN1,TFILE←INCHWL,ER); END;
00750	J←K←L←STATE←VAL←R←0;
00760	SETFORMAT(1,0);  FILEQ←CVS(PP); JP←1000; R←0; CLRBUF;
00763	
00764	WHILE EOF=0 DO BEGIN "USE"
00766	IF EOF≠0 THEN DONE ELSE DATAIN;
00767	FOR J←0 STEP 1 UNTIL 511 DO BEGIN
00768	  VAL←ILDB(POINTX); IF VAL>2047 THEN VAL←VAL-4096; D[J]←VAL; END;
00769	SEGIN←4; FVAL[1]←FVAL[2]←0;
00770	
00780	READT←FILEO[1 TO 3]&FILEQ&".T0X[11,ALS]";
00790	CLOSE(CHAN2); OPEN(CHAN2,"DSK",'10,10,0,0,0,EOFA);
00800	LOOKUP(CHAN2,READT,ER); TFILE←READT;
00810	WHILE ER DO BEGIN
00820	   IF PP>1 THEN BEGIN OUTSTR("Out of data, will start over."&CRLF);
00830	     GOTO STARTP; END;
00840	   OUTSTR(CRLF&"Can not find file "&TFILE&"  File= ");
00850	   LOOKUP(CHAN2,TFILE←INCHWL,ER); END;
00860	ARRYIN(CHAN2,LFILE[0],'200);	⊂ Input header;
00865	LFX←21; JPX←KK←-1;
00867	
00870	SEGTOT←(LFILE[0]*6)%256;
00880	⊃ OUTSTR(FILEI&" "&CVS(SEGTOT)&"   ");
00881	
00882	FILEP←FILEO[1 TO 3]&FILEQ&".SYN[SYN,ALS]";
00883	CLOSE(CHAN5); OPEN(CHAN5,"DSK",'14,0,2,0,0,0);
00885	ENTER(CHAN5,FILEP,0);
00892	OUTSTR("File "&FILEP&" has been opened");
00898	 ARRYOUT(CHAN5,LFILE[0],'200); ⊂ Write header;
00899	OUTSTR(" and header information written."&CRLF);
00900	READ2←READT;
00910	READTT←SCAN(READ2,16,J)&"P[PIT,NJM]";
00920	⊂ OUTSTR(READTT&CRLF);
00930	CLOSE(CHAN3); OPEN(CHAN3,"DSK",'10,10,0,0,0,EOFT);
00940	LOOKUP(CHAN3,READTT,ER); TFILE←READTT;
00956	FOR I←0 STEP 1 UNTIL 8 DO FVAL[I]←0; KTT←0;
00960	IF ER THEN BEGIN
00970	  OUTSTR("No .P data (S to start over, space bar to ignore) ");
00980	  IF (READ1←INCHRW)="S" THEN GOTO STARTP ELSE BEGIN
00990	    BUFTT[0]←'77777; BUFTT[1]←'377777700000;ITT←0; JTT←'3777777;
01000	    CLRBUF; END; END;
01005	DTTTIN;
01006	FVAL[6]←BUFTT[0]; FVAL[3]←(FVAL[6] LSH -15)-(SEGIN-4)*128;
01007	OUTSTR("AT 1007 SEGIN= "&CVS(SEGIN)&TB&" FVAL[6]= "&CVS(FVAL[6])&CRLF);
01010	
01030	
01050	
01160	
01170	⊂ Begin "GET";
01180	
01190	WHILE TRUE DO BEGIN "GET"
01200	
01210	SEGCS←J; FX←1;
01550	
01560	⊂ OUTSTR("JTT="&CVS(JTT)&TB&"J="&CVS(J)&CRLF);
01570	IF JJ<SEGIN THEN IF EOF≠0 THEN DONE "USE" ELSE DATAIN;
01592	
01600	⊂ OUTSTR("JJ="&CVS(JTT)&TB&"J="&CVS(J)&"before DTTTIN");
01610	IF JJT<SEGIN THEN DATTIN;
01640	IF JTT<(SEGIN-1)*128 THEN DTTTIN; 
01650	⊂ OUTSTR(" and after JTT="&CVS(JTT)&CRLF);
01651	
01652	⊂  FVAL ASSIGNMENTS
01653		[1]	DELTA FOR FIRST MARKER
01654		[2]	DELTA FOR SECOND MARKER
01655		[3]	DELTA FOR THIRD MARKER
01656		[4]	PULSE DATE FOR FIRST MARKER
01657		[5]	PULSE DATA FOR SECOND MARKER
01658		[6]	PULSE DATA FOR THIRD MARKER;
01659	
01660	
01670	FVAL[1]←FVAL[2]; NEW[NX]←FVAL[4]←FVAL[5]; NX←NX+1;
01674	⊂ OUTSTR(CVS(FVAL[1])&TB&CVS(FVAL[2])&TB&CVS(FVAL[3])&TB&CVOS(FVAL[4])&
01676	  " "&CVOS(FVAL[5])&" "&CVOS(FVAL[6])&CRLF);
01678	  WHILE FVAL[1]>127 DO BEGIN
01680	    FOR Q←0 STEP 1 UNTIL 383 DO D[Q]←D[Q+128];
01682	    FOR Q←384 STEP 1 UNTIL 511 DO BEGIN
01684	      VAL←ILDB(POINTX); IF VAL>2047 THEN VAL←VAL-4096;
01686	      D[Q]←VAL; END; SEGIN←SEGIN+1;
01688	    IF SEGIN>JJ THEN IF EOF≠0 THEN DONE "USE" ELSE DATAIN;
01690	    FVAL[1]←FVAL[1]-128; FVAL[3]←FVAL[3]-128; END;
01692	IF (FVAL[3]-FVAL[1])>256 THEN BEGIN
01694	  FVAL[2]←FVAL[1]+256;
01696	  FVAL[5]←(FVAL[4] LAND '377777700000)+'40000000; END
01697	ELSE BEGIN FVAL[2]←FVAL[3];  FVAL[5]←FVAL[6]; 
01736	     KTT←KTT+1; IF KTT≥512 THEN DTTTIN;
01775	    FVAL[6]←BUFTT[KTT];
01776	    FVAL[3]←(FVAL[6] LSH -15)-(SEGIN-4)*128;END;
01778	⊂ OUTSTR(CVS(FVAL[1])&TB&CVS(FVAL[2])&TB&CVS(FVAL[3])&TB&CVOS(FVAL[4])&
01780	  " "&CVOS(FVAL[5])&" "&CVOS(FVAL[6])&CRLF);
01783	CLRBUF;
01784	OUTSTR(CVS(FVAL[1])&TB&CVS(FVAL[2])&TB&CVS(FVAL[4] LSH -15)&TB&CVS(FVAL[5] LSH -15)&CRLF);
01785	FORM(1);
01786	⊂ PREPARE;
01790	WHILE JPX+KK<(FVAL[4] LSH -15) DO BEGIN
01792	    IF (LFILE[LFX]=0) THEN DONE; IF LFX>'177 THEN DONE;
01794	    JPX←J←LDB(POINT(14,LFILE[LFX],27)); KK←LDB(POINT(8,LFILE[LFX],35));
01796	    L←LFILE[LFX] LAND '777760000000;
01797	    LFX←LFX+1; END;
01798	    IF JPX<(FVAL[5] LSH -15) THEN OUTSTR(CVSTR(L)&" ");
01799	
01813	R←R+1;  OUTSTR(CVS(FVAL[4] LSH -15)&TB);
01840	
01845	JP←JP-1; READ1←INCHRS;
01850	 IF (READ1=" ")∨(JP=0)  THEN  BEGIN "SHOW"
01860	TYPLOC(512,170); DPYSET(DPYBUF);
01870	OUTSTR(CRLF&"File "&FILEN&CRLF);
01880	  OUTSTR(CRLF&"Data for interval from "&CVS(FVAL[4] LSH -15)
01885	    &" to "&CVS(FVAL[5] LSH -15));
01890	  FOR I←21 STEP 1 UNTIL 127 DO BEGIN
01900	    IF (LFILE[I]=0) THEN DONE;
01910	    JPX←J←LDB(POINT(14,LFILE[I],27)); KK←LDB(POINT(8,LFILE[I],35));
01920	    L←LFILE[I] LAND '777760000000;
01921	    IF JPX+KK>(FVAL[4] LSH 15) THEN DONE; END;
02048	  FOR Q←0 STEP 1 UNTIL 126 DO IF L=SYMBOL[Q] THEN DONE;
02050	IF JPX>(FVAL[5] LSH -15) THEN OUTSTR(" is undesignated."&crlf) else 
02060	  OUTSTR(" is designated as the phone "&CVSTR(L));OUTSTR(CRLF);
02200	AIVECT(-599,0);MARK;
02205	AIVECT(-599,-340); RARDIS;
02210	CLRBUF; DPYOUT(0);PTOCHW(0,'10120);
02217	  OUTSTR("Type P for XGP copy file or type next command.");
02230	⊂ FOR QQ←4 STEP 1 UNTIL 4095 DO IF DPYBUF[QQ] =1 THEN DONE;
02240	⊂ OUTSTR("DPYBUF filled to "&CVS(QQ)&CRLF);
02250	
02260	READ1←INCHRW;
02270	WHILE (READ1="W")∨(READ1="w") DO BEGIN DPYOUT(0) ;
02280	  PTOCHW(0,'10120);READ1←INCHRW; END;
02290	IF (READ1="P")∨(READ1="p") THEN BEGIN CALCOMP("PLOTX",DPYBUF);
02300	  OUTSTR("EX DPYXGP[X,ALS] plots PLOTX.GRF on the XGP.  Next command please."&CRLF);
02310	  READ1←INCHRW;   END;
02360	K←CVASC(READ1); OPT1←0;
02370	
02380	IF K≥CVASC("+") THEN IF K≤CVASC("9") THEN BEGIN
02390	  JP←CVD(READ1&INCHWL);END;
02410	  OUTSTR(CR);
02420	  IF READ1=" " THEN JP←10000;
02423	  IF(READ1="F")∨(READ1="f") THEN JP←-1;
02427	
02430	IF (READ1='15)∨(READ1='12) THEN BEGIN JP←1; CLRBUF; END;
02437	
02450	TOFORM:
02510	  IF (READ1="S")∨(READ1="s") THEN JP←JP+1;
02540	  IF (READ1="E")∨(READ1="e") THEN GOTO STOPP;
02550	END "SHOW";
02560	END "GET";
02585	END "USE";
02587	ARRYOUT(CHAN5,NEW[0],512);CLOSE(CHAN5);NX←0;
02589	IF JP<0 THEN DONE;
02590	END "FILEREAD";
02600	
02610	OUTSTR("Data are exhausted"&CRLF&LF); GOTO STARTP;
02620	STOPP: PTOCHW(0,'10103); PTOCHW(0,'10120);
02630	
02640	END "FIX";
02650